home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SORTING.SWG / 0001_Demo QUICKSORT.pas
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  3.1 KB  |  83 lines
  1.  
  2. {************************************************}
  3. {                                                }
  4. { QuickSort Demo                                 }
  5. { Copyright (c) 1985,90 by Borland International } { und: Robert Beicht ;-) }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program QSort;
  10. {$R-,S-}
  11. uses Crt;
  12.  
  13. { This program demonstrates the quicksort algorithm, which      }
  14. { provides an extremely efficient method of sorting arrays in   }
  15. { memory. The program generates a list of 1000 random numbers   }
  16. { between 0 and 29999, and then sorts them using the QUICKSORT  }
  17. { procedure. Finally, the sorted list is output on the screen.  }
  18. { Note that stack and range checks are turned off (through the  }
  19. { compiler directive above) to optimize execution speed.        }
  20.  
  21. const
  22.   Max = 100;
  23.  
  24. type                                                                  { ***** }
  25.   PData = ^TData;                                                     { ***** }
  26.   TData = record                                                      { ***** }
  27.     NachName: String[25];                                             { ***** }
  28.     VorName:  String[25];                                             { ***** }
  29.     {..}                                                              { ***** }
  30.   end;                                                                { ***** }
  31.   
  32.   List = array[1..Max] of TData;
  33.  
  34. var
  35.   Data: List;
  36.   I: Integer;
  37.  
  38. function Less(var d1,d2:TData): Boolean;                              { ***** }
  39. begin                                                                 { ***** }
  40.   if d1.NachName < d2.NachName then Less := True  else                { ***** }
  41.   if d1.NachName > d2.NachName then Less := False else                { ***** }
  42.     if d1.VorName < d2.VorName then Less := True  else                { ***** }
  43.     if d1.VorName > d2.VorName then Less := False else Less := False; { ***** }
  44. end;                                                                  { ***** }
  45.  
  46. { QUICKSORT sorts elements in the array A with indices between  }
  47. { LO and HI (both inclusive). Note that the QUICKSORT proce-    }
  48. { dure provides only an "interface" to the program. The actual  }
  49. { processing takes place in the SORT procedure, which executes  }
  50. { itself recursively.                                           }
  51.  
  52. procedure QuickSort(var A: List; Lo, Hi: Integer);
  53.  
  54. procedure Sort(l, r: Integer);
  55. var
  56.   i, j, x: integer;                                                   { ***** }
  57.   y: TData;                                                           { ***** }
  58. begin
  59.   i := l; j := r; x := (l+r) DIV 2;
  60.   repeat
  61.     while Less(a[i], a[x]) do i := i + 1;                             { ***** }
  62.     while Less(a[x], a[j]) do j := j - 1;                             { ***** }
  63.     if i <= j then
  64.     begin
  65.       y := a[i]; a[i] := a[j]; a[j] := y;
  66.       i := i + 1; j := j - 1;
  67.     end;
  68.   until i > j;
  69.   if l < j then Sort(l, j);
  70.   if i < r then Sort(i, r);
  71. end;
  72.  
  73. begin {QuickSort};
  74.   Sort(Lo,Hi);
  75. end;
  76.  
  77. begin {QSort}
  78.  
  79.   (*Initialisiere List*)
  80.   Sort(List, 1, Count);
  81.  
  82. end.
  83.